Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH8/SRC/CHAOS.FRM

Visual Basic Form | 1996-05-02 | 5.2 KB | 184 lines

VERSION 4.00
Begin VB.Form ChaosForm
   Caption         =   "Chaos Game"
   ClientHeight    =   4575
   ClientLeft      =   2280
   ClientTop       =   1185
   ClientWidth     =   5535
   Height          =   5265
   Left            =   2220
   LinkTopic       =   "Form1"
   ScaleHeight     =   305
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   369
   Top             =   555
   Width           =   5655
   Begin VB.PictureBox Canvas
      AutoRedraw      =   -1  'True
      FillStyle       =   0  'Solid
      Height          =   4560
      Left            =   960
      ScaleHeight     =   300
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   300
      TabIndex        =   1
      Top             =   0
      Width           =   4560
   End
   Begin VB.CommandButton CmdGo
      Caption         =   "Go"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   735
   End
   Begin MSComDlg.CommonDialog FileDialog
      Left            =   240
      Top             =   1440
      _version        =   65536
      _extentx        =   847
      _extenty        =   847
      _stockprops     =   0
      cancelerror     =   -1  'True
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileLoad
         Caption         =   "&Load..."
         Shortcut        =   ^L
      End
      Begin VB.Menu mnuFileSep
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "ChaosForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim NumAnchors As Integer
Dim AnchorX() As Single
Dim AnchorY() As Single
Dim Running As Boolean
' ************************************************
' Draw the anchor points.
' ************************************************
Sub DrawAnchors()
Const GAP = 2
Dim i As Integer
    Canvas.Cls
    For i = 1 To NumAnchors
        Canvas.Line _
            (AnchorX(i) - GAP, AnchorY(i) - GAP)- _
            Step(2 * GAP, 2 * GAP), , BF
    Next i
End Sub
' ************************************************
' Load the anchor points.
' ************************************************
Sub LoadChaosData(fname As String)
Dim fnum As Integer
Dim i As Integer
    fnum = FreeFile
    Open fname For Input Access Read As #fnum
    Input #fnum, NumAnchors
    ReDim AnchorX(1 To NumAnchors)
    ReDim AnchorY(1 To NumAnchors)
    For i = 1 To NumAnchors
        Input #fnum, AnchorX(i), AnchorY(i)
    Next i
    Close #fnum
    DrawAnchors
    Caption = "Chaos Game [" & fname & "]"
    CmdGo.Enabled = True
End Sub
' ************************************************
' Play the chaos game.
' ************************************************
Sub PlayGame()
Dim wid As Single
Dim hgt As Single
Dim x As Single
Dim y As Single
Dim anchor As Integer
Dim i As Integer
    ' See how much room we have.
    wid = Canvas.ScaleWidth
    hgt = Canvas.ScaleHeight
    ' Pick a random starting point.
    x = wid * Rnd
    y = hgt * Rnd
    ' Start the game.
    i = 0
    Do While Running
        ' Pick a random anchor point.
        anchor = Int(NumAnchors * Rnd + 1)
        ' Move halfway there.
        x = (x + AnchorX(anchor)) / 2
        y = (y + AnchorY(anchor)) / 2
        Canvas.PSet (x, y)
        ' To make things faster, only DoEvents
        ' every 100 times.
        i = i + 1
        If i > 100 Then
            i = 0
            DoEvents
        End If
    Loop
End Sub
Private Sub CmdGo_Click()
Dim i As Integer
    If Running Then
        Running = False
        CmdGo.Enabled = False
        CmdGo.Caption = "Stopped"
    Else
        Running = True
        CmdGo.Caption = "Stop"
        DrawAnchors
        PlayGame
        CmdGo.Enabled = True
        CmdGo.Caption = "Go"
    End If
End Sub
Private Sub Form_Resize()
    Canvas.Move Canvas.Left, 0, _
        ScaleWidth - Canvas.Left, ScaleHeight - 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
    End
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub
' ************************************************
' Load a file describing the anchor points.
' ************************************************
Private Sub mnuFileLoad_Click()
Dim fname As String
    ' Allow the user to pick a file.
    On Error Resume Next
    FileDialog.FilterIndex = 1
    FileDialog.filename = "*.CHA"
    FileDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
    FileDialog.ShowOpen
    If Err.Number = cdlCancel Then
        Exit Sub
    ElseIf Err.Number <> 0 Then
        Beep
        MsgBox "Error selecting file.", , vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    fname = Trim$(FileDialog.filename)
    FileDialog.InitDir = Left$(fname, Len(fname) _
        - Len(FileDialog.FileTitle) - 1)
    ' Load the information.
    LoadChaosData fname
End Sub